home *** CD-ROM | disk | FTP | other *** search
/ Archive Magazine CD 1995 / Archive Magazine CD 1995.iso / discs / prog_disc / volume_7 / issue_10 / adv_basic / !Proggy2 / !RunImage (.txt) < prev    next >
Encoding:
RISC OS BBC BASIC V Source  |  1994-05-15  |  4.6 KB  |  189 lines
  1.            >!RunImage
  2.  Program   Test Program For Receiving User Messages
  3. init             
  4.  quit%:
  5.  start of poll loop                         
  6.  "Wimp_Poll",0,bk% 
  7.  reason%
  8.  reason% 
  9.   2   :
  10.  "Wimp_OpenWindow",,bk%
  11.   3   :
  12.  "Wimp_CloseWindow",,bk%
  13.   6   :
  14. button
  15.   9   :
  16. menuselect
  17.  17,18:
  18. message
  19.  "Wimp_CloseDown"
  20. button
  21.  bk%!8 
  22.  read button state
  23.  bk%!12=-2 
  24. 5     
  25.  if Menu pressed over iconbar, create menu 
  26. 0     
  27.  "Wimp_CreateMenu",,menu%,!bk%-64,184
  28.  bk%!12 
  29.      
  30. ,       
  31.  <SELECT> used on iconbar icon..
  32.        !bk%= mainw%
  33. !(       
  34.  "Wimp_GetWindowState",,bk%
  35.        bk%!28 = -1
  36. #$       
  37.  "Wimp_OpenWindow",,bk%
  38. menuselect
  39.  button%
  40.  "Wimp_GetPointerInfo",,bk%+256
  41.  read button state
  42. ,+button%=bk%!264                        
  43.  !bk% 
  44.  quit if item 1 chosen
  45. 0$   quit%=
  46.                       
  47.  re-open menu if Adjust was  pressed
  48.  button%=1 
  49.  "Wimp_CreateMenu",,menu%:
  50. message
  51.  msg$
  52.  bk%!16 
  53. 9G                                         
  54.  read message action code
  55.  0      :quit%=
  56. :                
  57.  quit if Quit message received
  58.  &43B00
  59. <       
  60.    msg$ = 
  61. string(bk% + 20)
  62. >    
  63. msg$,8) = "Proggy2:" 
  64.      msg$ = 
  65. msg$,9)
  66. @,     
  67. shell_IconPutData(mainw%,0,msg$,
  68. string(a%)                        
  69.  convert a null-terminated string into CR-terminated
  70.  ?a%<>0
  71.  a$+=
  72. ?a%:a%+=1
  73.  bk% 2000,menu% 75,ind% 2000,name% 11
  74. quit%=0:name$="Proggy2"
  75. err%=0
  76.  "OS_ReadVarVal","Proggy2$Dir",bk%,255,0,3 
  77.  ,,i%
  78. bk%?i%=13:dir$=$bk%
  79.  "Wimp_Initialise",200,&4B534154,name$
  80. error:
  81.  "Wimp_OpenTemplate",,dir$+".Templates"
  82. i%=ind%
  83. infohan%=
  84. create("InfoBox")
  85. mainw%  =
  86. create("mainw")
  87.  "Wimp_CloseTemplate"
  88. Z%!bk%=-1:bk%!4=0:bk%!8=0:bk%!12=68
  89. [/bk%!16=68:bk%!20=&3002:$(bk%+24)="!Proggy2"
  90.  "Wimp_CreateIcon",,bk%
  91. setupmenu(menu%)
  92. setupmenu(m%)
  93.  $m%,num%:len%=
  94. ($m%)-2
  95. b!m%!12=&70207:m%!20=44:m%!24=0
  96. m%+=28:
  97.  i%=1 
  98.  num%
  99.  !m%=-&80*(i%=num%):
  100.  m%!4
  101. e# m%!8=&7009021:
  102.  a$:$(m%+12)=a$
  103. a$>len% len%=
  104.  m%+=24
  105. :menu%!16=16*(len%+1)
  106. create(a$)
  107. $name%=a$
  108.  "Wimp_LoadTemplate",,bk%,i%,ind%+2000,-1,name%,0 
  109.  ,,i%
  110.  "Wimp_CreateWindow",,bk% 
  111.  handle%
  112. =handle%
  113. error
  114. report(
  115. $+" - internal error code "+
  116.  "Wimp_CloseDown"
  117. report(a$,x%)
  118. !bk%=1:$(bk%+4)=a$+
  119.  "Wimp_ReportError",bk%,x%,name$
  120.  Proggy2,2,infohan%,Info,-1,Quit
  121.  --- Memory Management Routines ----------------------------------------
  122. _heap_get(size%)
  123.  ptr%,heap%,flags%
  124.  Returns pointer to new memory block unless claim fails
  125.  in which case -1 is returned
  126.  First find start address of RMA..
  127.  "OS_ReadDynamicArea",1 
  128.  heap%
  129.  Now claim memory, trapping errors by using X form of SWI..
  130.  "XOS_Module",6,,,size% 
  131.  ,,ptr%;flags%
  132.  If error occured return -1, else return address of allocated
  133.  block
  134.  (flags% 
  135.  ptr% = -1
  136. = ptr%
  137. _heap_release(
  138.  ptr%)
  139.  maxfree%,nrpages%,flags%
  140.  Returns  0 if block released OK
  141.  Returns -1 if operation failed (i.e. block doesn't exist)
  142.  "XOS_Module",7,,ptr% 
  143.  ;flags%:
  144.  Free the block
  145.  (flags% 
  146.  1) = 0 
  147.  Block was released successfully...
  148.   ptr% = 0
  149.  Error occured trying to free the block, return -1 to signal to the
  150.  program that something went wrong (normally the program would ignore
  151.  this anyway)
  152.   ptr% = -1
  153. shell_IconPutData(whandle%,ihandle%,data$,redraw)
  154.  blk%,old_str$
  155. 4old_str$ = 
  156. shell_IconGetData(whandle%,ihandle%)
  157.  data$ <> old_str$ 
  158.   blk%=
  159. _heap_get(40)
  160.   blk%!0 = whandle%
  161.   blk%!4 = ihandle%
  162.  "Wimp_GetIconState",,blk%
  163.  (blk%!24 
  164.  (1<<8)) <> 0 
  165. 2    
  166. data$ > blk%!36 
  167.  99,"Icon overflow!"
  168.     $(blk%!28) = data$
  169. !    $(blk% + 28) = 
  170. data$,11)
  171.  redraw <> 0 
  172.     blk%!8 = 0:blk%!12 = 0
  173. $    
  174.  "Wimp_SetIconState",,blk%
  175. _heap_release(blk%)
  176. shell_IconGetData(whandle%,ihandle%)
  177.  result$,icon_blk%
  178. icon_blk%=
  179. _heap_get(40)
  180. icon_blk%!0=whandle%
  181. icon_blk%!4=ihandle%
  182.  "Wimp_GetIconState",,icon_blk%
  183.  (icon_blk%!24 
  184.  (1<<8))<>0 
  185.  result$=$(icon_blk%!28) 
  186.  result$=$(icon_blk%+28)
  187. _heap_release(icon_blk%)
  188. =result$
  189.